home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / mpfeel.lha / MPFeel / chars.c < prev    next >
C/C++ Source or Header  |  1992-10-06  |  19KB  |  664 lines
  1. /* ******************************************************************** */
  2. /*  chars.c          Copyright (C) Codemist and University of Bath 1989 */
  3. /*                                                                      */
  4. /* Basic character, string and symbol functions                */
  5. /* ******************************************************************** */
  6.  
  7. /*
  8.  * $Id: chars.c,v 1.6 1992/01/29 13:38:48 pab Exp $
  9.  *
  10.  * $Log: chars.c,v $
  11.  * Revision 1.6  1992/01/29  13:38:48  pab
  12.  * sysV fixes
  13.  *
  14.  * Revision 1.5  1992/01/09  22:28:45  pab
  15.  * Fixed for low tag ints
  16.  *
  17.  * Revision 1.4  1991/12/22  15:13:55  pab
  18.  * Xmas revision
  19.  *
  20.  * Revision 1.3  1991/11/15  13:44:28  pab
  21.  * copyalloc rev 0.01
  22.  *
  23.  * Revision 1.2  1991/09/11  12:07:04  pab
  24.  * 11/9/91 First Alpha release of modified system
  25.  *
  26.  * Revision 1.1  1991/08/12  16:49:30  pab
  27.  * Initial revision
  28.  *
  29.  * Revision 1.4  1991/02/13  18:18:07  kjp
  30.  * Symbol and string allocation corrections + RCS log header.
  31.  *
  32.  */
  33.  
  34. /*
  35.  * Change Log:
  36.  *   Version 1, May 1989
  37.  *    Checked for GC protection - JPff
  38.  */
  39.  
  40. #include <string.h>
  41. #include <ctype.h>
  42. #include "funcalls.h"
  43. #include "defs.h"
  44. #include "structs.h"
  45. #include "error.h"
  46. #include "global.h"
  47.  
  48. #include "modboot.h"
  49. #include "symboot.h"
  50. #include "calls.h"
  51.  
  52. /* These functions are taken from the CHARACTERS AND STRINGS section */
  53.  
  54. EUFUN_1( Fn_characterp, form)
  55. {
  56.   return (is_char(form) ? lisptrue : nil);
  57. }
  58. EUFUN_CLOSE
  59.  
  60. EUFUN_1( Fn_int2char, form)
  61. {
  62.   while (typeof(form)!=TYPE_INT)
  63.     form = CallError(stacktop,
  64.           "Not an integer in integer-to-character",form,CONTINUABLE);
  65.   return allocate_char(stackbase, intval(form));
  66. }
  67. EUFUN_CLOSE
  68.  
  69. EUFUN_1( Fn_char2int, form)
  70. {
  71.   while (!is_char(form))
  72.     form = CallError(stacktop,
  73.          "Not a character in character-to-integer",form,CONTINUABLE);
  74.   return allocate_integer(stackbase, (int)(form->CHAR).code);
  75. }
  76. EUFUN_CLOSE
  77.  
  78. /* ******************************** */
  79. /* Latin-character-operators module */
  80. /* ******************************** */
  81.  
  82. EUFUN_1( Fn_charalphap, form)
  83. {
  84.   while (!is_char(form))
  85.     form = CallError(stacktop,"Not a character in char-alphabetic-p",form,CONTINUABLE);
  86.   return (isalpha((form->CHAR).code) ? lisptrue : nil);
  87. }
  88. EUFUN_CLOSE
  89.  
  90. EUFUN_1( Fn_charnump, form)
  91. {
  92.   while (!is_char(form))
  93.     form = CallError(stacktop,"Not a character in char-numeric-p",form,CONTINUABLE);
  94.   return (isdigit((form->CHAR).code) ? lisptrue : nil);
  95. }
  96. EUFUN_CLOSE
  97.  
  98. EUFUN_1( Fn_charwhitep, form)
  99. {
  100.   while (!is_char(form))
  101.     form = CallError(stacktop,"Not a character in char-whitespace-p",form,CONTINUABLE);
  102.   return (isspace((form->CHAR).code) ? lisptrue : nil);
  103. }
  104. EUFUN_CLOSE
  105.  
  106. EUFUN_1( Fn_charpuncp, form)
  107. {
  108.   while (!is_char(form))
  109.     form = CallError(stacktop,"Not a character in char-punctuation-p",form,CONTINUABLE);
  110.   return (ispunct((form->CHAR).code) ? lisptrue : nil);
  111. }
  112. EUFUN_CLOSE
  113.  
  114. EUFUN_1( Fn_charotherp, form)
  115. {
  116.   while (!is_char(form))
  117.     form = CallError(stacktop,"Not a character in char-other-p",form,CONTINUABLE);
  118.   return (isgraph((form->CHAR).code) ? lisptrue : nil);
  119. }
  120. EUFUN_CLOSE
  121.  
  122. EUFUN_1( Fn_charupperp, form)
  123. {
  124.   while (!is_char(form))
  125.     form = CallError(stacktop,"Not a character in char-upper-case-p",form,CONTINUABLE);
  126.   return (isupper((form->CHAR).code) ? lisptrue : nil);
  127. }
  128. EUFUN_CLOSE
  129.  
  130. EUFUN_1( Fn_charlowerp, form)
  131. {
  132.   while (!is_char(form))
  133.     form = CallError(stacktop,"Not a character in char-lower-case-p",form,CONTINUABLE);
  134.   return (islower((form->CHAR).code) ? lisptrue : nil);
  135. }
  136. EUFUN_CLOSE
  137.  
  138. EUFUN_1( Fn_charupper, form)
  139. {
  140.   while (!is_char(form))
  141.     form = CallError(stacktop,"Not an character in char-upcase",form,CONTINUABLE);
  142.   return allocate_char(stackbase, toupper(intval(form)));
  143. }
  144. EUFUN_CLOSE
  145.  
  146. EUFUN_1( Fn_charlower, form)
  147. {
  148.   while (!is_char(form))
  149.     form = CallError(stacktop,"Not an character in char-downcase",form,CONTINUABLE);
  150.   return allocate_char(stackbase, tolower(intval(form)));
  151. }
  152. EUFUN_CLOSE
  153.  
  154. /* ************************************ */
  155. /* Universal-character-operators module */
  156. /* ************************************ */
  157.  
  158. EUFUN_2( Fn_chareq, form1, form2)
  159. {
  160.   while (!is_char(form1))
  161.     form1 = CallError(stacktop,"Not a character in char-equal",form1,CONTINUABLE);
  162.   while (!is_char(form2))
  163.     form2 = CallError(stacktop,"Not a character in char-equal",form2,CONTINUABLE);
  164.   return ((form1->CHAR).code == (form2->CHAR).code ? lisptrue : nil);
  165. }
  166. EUFUN_CLOSE
  167.  
  168. EUFUN_2( Fn_charls, form1, form2)
  169. {
  170.   while (!is_char(form1))
  171.     form1 = CallError(stacktop,"Not a character in char<",form1,CONTINUABLE);
  172.   while (!is_char(form2))
  173.     form2 = CallError(stacktop,"Not a character in char<",form2,CONTINUABLE);
  174.   return ((form1->CHAR).code < (form2->CHAR).code ? lisptrue : nil);
  175. }
  176. EUFUN_CLOSE
  177.  
  178. EUFUN_2( Fn_chargt, form1, form2)
  179. {
  180.   while (!is_char(form1))
  181.     form1 = CallError(stacktop,"Not a character in char>",form1,CONTINUABLE);
  182.   while (!is_char(form2))
  183.     form2 = CallError(stacktop,"Not a character in char>",form2,CONTINUABLE);
  184.   return ((form1->CHAR).code > (form2->CHAR).code ? lisptrue : nil);
  185. }
  186. EUFUN_CLOSE
  187.  
  188. EUFUN_2( Fn_charle, form1, form2)
  189. {
  190.   while (!is_char(form1))
  191.     form1 = CallError(stacktop,"Not a character in char<=",form1,CONTINUABLE);
  192.   while (!is_char(form2))
  193.     form2 = CallError(stacktop,"Not a character in char<=",form2,CONTINUABLE);
  194.   return ((form1->CHAR).code <= (form2->CHAR).code ? lisptrue : nil);
  195. }
  196. EUFUN_CLOSE
  197.  
  198. EUFUN_2( Fn_charge, form1, form2)
  199. {
  200.   while (!is_char(form1))
  201.     form1 = CallError(stacktop,"Not a character in char>=",form1,CONTINUABLE);
  202.   while (!is_char(form2))
  203.     form2 = CallError(stacktop,"Not a character in char>=",form2,CONTINUABLE);
  204.   return ((form1->CHAR).code >= (form2->CHAR).code ? lisptrue : nil);
  205. }
  206. EUFUN_CLOSE
  207.  
  208. /* STRINGS */
  209.  
  210. EUFUN_1( Fn_stringp, form)
  211. {
  212.   return (is_string(form) ? lisptrue : nil);
  213. }
  214. EUFUN_CLOSE
  215.  
  216. EUFUN_1( Fn_string_copy, form)
  217. {
  218.   LispObject ans;
  219.   while (!is_string(form)) 
  220.     form = CallError(stacktop,"Not a string in string-copy",form,CONTINUABLE);
  221.   ans = allocate_string(stackbase,
  222.             stringof(form),strlen(stringof(form)));
  223.   return ans;
  224. }
  225. EUFUN_CLOSE
  226.  
  227. EUFUN_1( Fn_string_length, form)
  228. {
  229.   while (!is_string(form))
  230.     form = CallError(stacktop,"Not a string in string-length",form,CONTINUABLE);
  231.   return allocate_integer(stackbase, strlen(stringof(form)));
  232. }
  233. EUFUN_CLOSE
  234.  
  235. EUFUN_2( Fn_sref, form, off)
  236. {
  237.   while (!is_string(form))
  238.     form = CallError(stacktop,"Not a string in string-ref",form,CONTINUABLE);
  239.   while (typeof(off)!=TYPE_INT)
  240.     off = CallError(stacktop,"Not an integer in string-ref",form,CONTINUABLE);
  241.   return allocate_char(stackbase, (stringof(form))[intval(off)]);
  242. }
  243. EUFUN_CLOSE
  244.  
  245. EUFUN_3( Fn_sref_setter, form, off, ch)
  246. {
  247.   while (!is_string(form))
  248.     form = CallError(stacktop,"Not a string in string-ref",form,CONTINUABLE);
  249.   while (typeof(off)!=TYPE_INT)
  250.     off = CallError(stacktop,"Not an integer in string-ref",form,CONTINUABLE);
  251.   while (!is_char(ch))
  252.     off = CallError(stacktop,"Not an character in string-ref",form,CONTINUABLE);
  253.   stringof(form)[intval(off)] = (ch->CHAR).code;
  254.   return nil;
  255. }
  256. EUFUN_CLOSE
  257.  
  258. EUFUN_3( Fn_substring, str, start, end)
  259. {
  260.   int len;
  261.   int istart;
  262.   int iend;
  263.   while (!is_string(str))
  264.     str = CallError(stacktop,"Not a string in substring",str,CONTINUABLE);
  265.   while (typeof(start)!=TYPE_INT)
  266.     start = CallError(stacktop,"Not an integer in substring",start,CONTINUABLE);
  267.   while (typeof(end)!=TYPE_INT)
  268.     end = CallError(stacktop,"Not an integer in substring",end,CONTINUABLE);
  269.   len = strlen(stringof(str));
  270.   istart = intval(start);
  271.   iend = intval(end);
  272.   if (istart<0 || istart>=len || iend<0 || iend>=len || iend<istart) {
  273.     printf("Illegal arguments to substring\n");
  274.     return nil;
  275.   }
  276.   {
  277.     char buff[256];
  278.     for (len = 0 ; istart<=iend; istart++, len++)
  279.       buff[len] = (stringof(str))[istart];
  280.     buff[len] = '\0';
  281.     return allocate_string(stackbase, buff,len);
  282.   }
  283. }
  284. EUFUN_CLOSE
  285.  
  286. EUFUN_2( Fn_string_append, str1, str2)
  287. {
  288.   int len;
  289.   char buff[256];
  290.  
  291.   while (!is_string(str1))
  292.     str1 = CallError(stacktop,"Not a string in string-append",str1,CONTINUABLE);
  293.   while (!is_string(str2))
  294.     str2 = CallError(stacktop,"Not a string in string-append",str2,CONTINUABLE);
  295.   len = strlen(stringof(str1));
  296.   strcpy(buff,stringof(str1));
  297.   strcpy(buff+len,stringof(str2));
  298.   return allocate_string(stackbase, buff,len+strlen(stringof(str2)));
  299. }
  300. EUFUN_CLOSE
  301.  
  302. /* **  String-operators module ** */
  303. EUFUN_1( Fn_string_list, form)
  304. {
  305.   LispObject ans=nil;
  306.   while (!is_string(form))
  307.     form = CallError(stacktop,"Not a string in string-to-list",form,CONTINUABLE);
  308.   {
  309.     char *str = stringof(form);
  310.     int n;
  311.     for (n= strlen(str)-1; n>=0; n--) {
  312.       LispObject x;
  313.       STACK_TMP(ans);
  314.       x = allocate_char(stacktop, str[n]);
  315.       UNSTACK_TMP(ans);
  316.       ARG_0(stacktop) = x;
  317.       ARG_1(stacktop) = ans;
  318.       ans = Fn_cons(stacktop);
  319.     }
  320.   }
  321.   return ans;
  322. }
  323. EUFUN_CLOSE
  324.  
  325.  
  326. EUFUN_2( Fn_string_equal, str1, str2)
  327. {
  328.   char *ss1;
  329.   char *ss2;
  330.   while (!is_string(str1))
  331.     str1 = CallError(stacktop,"Not a string in string-equal",str1,CONTINUABLE);
  332.   while (!is_string(str2))
  333.     str2 = CallError(stacktop,"Not a string in string-equal",str2,CONTINUABLE);
  334.   ss1 = stringof(str1);
  335.   ss2 = stringof(str2);
  336.   return (strcmp(ss1,ss2)==0 ? lisptrue: nil);
  337. }
  338. EUFUN_CLOSE
  339.  
  340. EUFUN_2( Fn_string_lt, str1, str2)
  341. {
  342.   char *ss1;
  343.   char *ss2;
  344.   while (!is_string(str1))
  345.     str1 = CallError(stacktop,"Not a string in string-lt",str1,CONTINUABLE);
  346.   while (!is_string(str2))
  347.     str2 = CallError(stacktop,"Not a string in string-lt",str2,CONTINUABLE);
  348.   ss1 = stringof(str1);
  349.   ss2 = stringof(str2);
  350.   return (strcmp(ss1,ss2)<0 ? lisptrue: nil);
  351. }
  352. EUFUN_CLOSE
  353.  
  354. EUFUN_2( Fn_string_gt, str1, str2)
  355. {
  356.   char *ss1;
  357.   char *ss2;
  358.   while (!is_string(str1))
  359.     str1 = CallError(stacktop,"Not a string in string-gt",str1,CONTINUABLE);
  360.   while (!is_string(str2))
  361.     str2 = CallError(stacktop,"Not a string in string-gt",str2,CONTINUABLE);
  362.   ss1 = stringof(str1);
  363.   ss2 = stringof(str2);
  364.   return (strcmp(ss1,ss2)>0 ? lisptrue: nil);
  365. }
  366. EUFUN_CLOSE
  367.  
  368. EUFUN_2( Fn_string_le, str1, str2)
  369. {
  370.   char *ss1;
  371.   char *ss2;
  372.   while (!is_string(str1))
  373.     str1 = CallError(stacktop,"Not a string in string-<=",str1,CONTINUABLE);
  374.   while (!is_string(str2))
  375.     str2 = CallError(stacktop,"Not a string in string-<=",str2,CONTINUABLE);
  376.   ss1 = stringof(str1);
  377.   ss2 = stringof(str2);
  378.   return (strcmp(ss1,ss2)<=0 ? lisptrue: nil);
  379. }
  380. EUFUN_CLOSE
  381.  
  382. EUFUN_2( Fn_string_ge, str1, str2)
  383. {
  384.   char *ss1;
  385.   char *ss2;
  386.   while (!is_string(str1))
  387.     str1 = CallError(stacktop,"Not a string in string->=",str1,CONTINUABLE);
  388.   while (!is_string(str2))
  389.     str2 = CallError(stacktop,"Not a string in string->=",str2,CONTINUABLE);
  390.   ss1 = stringof(str1);
  391.   ss2 = stringof(str2);
  392.   return (strcmp(ss1,ss2)>=0 ? lisptrue: nil);
  393. }
  394. EUFUN_CLOSE
  395.  
  396. /* SYMBOLS */
  397.  
  398. EUFUN_1( Fn_symbolp, form)
  399. {
  400.   return (is_symbol(form) ? lisptrue : nil);
  401. }
  402. EUFUN_CLOSE
  403.  
  404. EUFUN_1( Fn_make_symbol, str)
  405. {
  406.   while (!is_string(str))
  407.     str = CallError(stacktop,"Not a string in make-symbol",str,CONTINUABLE);
  408.   return (LispObject) get_symbol_by_copying(stackbase, stringof(str));
  409. }
  410. EUFUN_CLOSE
  411.  
  412. EUFUN_1( Fn_symbolname, form)
  413. {
  414.   while (!is_symbol(form))
  415.     form = CallError(stacktop,"Not symbol in symbol-name",form,CONTINUABLE);
  416.   return allocate_string(stackbase, (form->SYMBOL).pname,strlen((form->SYMBOL).pname));
  417. }
  418. EUFUN_CLOSE
  419.  
  420. EUFUN_1( Fn_symbolvalue, form)
  421. {
  422.   while (!is_symbol(form))
  423.     form = CallError(stacktop,"symbol-value: non symbol",form,CONTINUABLE);
  424.   if (form->SYMBOL.gvalue == NULL)
  425.     CallError(stacktop,"symbol-value: globally unbound",form,NONCONTINUABLE);
  426.   return (form->SYMBOL).gvalue;
  427. }
  428. EUFUN_CLOSE
  429.   
  430. EUFUN_2( Fn_symbolvalue_update, form, new)
  431. {
  432.   while (!is_symbol(form))
  433.     form = CallError(stacktop,"symbol-value: non-symbol",form,CONTINUABLE);
  434.   (form->SYMBOL).gvalue = new;
  435.   return nil;
  436. }
  437. EUFUN_CLOSE
  438.   
  439. EUFUN_1( Fn_symbolglobal, form)
  440. {
  441.   while (!is_symbol(form))
  442.     form = CallError(stacktop,"Not symbol in symbol-global",form,CONTINUABLE);
  443.   return (form->SYMBOL).gvalue;
  444. }
  445. EUFUN_CLOSE
  446.   
  447. EUFUN_2( Fn_symbolglobal_update, form, new)
  448. {
  449.   while (!is_symbol(form))
  450.     form = CallError(stacktop,"Not symbol in symbol-global",form,CONTINUABLE);
  451.   (form->SYMBOL).gvalue = new;
  452.   return nil;
  453. }
  454. EUFUN_CLOSE
  455.  
  456. EUFUN_1( Fn_explode, sym)
  457. {
  458.   LispObject list,last;
  459.   char *name;
  460.   char temp[5];
  461.  
  462.   if (!is_symbol(sym))
  463.     CallError(stacktop,"explode: not a symbol",sym,NONCONTINUABLE);
  464.  
  465.   name = sym->SYMBOL.pname;
  466.   last = list = nil;
  467.  
  468.   while (*name != '\0') {
  469.     LispObject symbit;
  470.  
  471.     temp[0] = *name; temp[1] = '\0';
  472.  
  473.     symbit = get_symbol_by_copying(stackbase, temp);
  474.  
  475.     if (last == nil) {
  476.       ARG_0(stacktop) = symbit;
  477.       ARG_1(stacktop) = nil;
  478.       list = Fn_cons(stacktop);
  479.       last = list;
  480.       STACK_TMP(list);
  481.     }
  482.     else {
  483.       LispObject x;
  484.       ARG_0(stacktop) = symbit;
  485.       ARG_1(stacktop) = last;
  486.       x = Fn_cons(stacktop);
  487.       last = ARG_1(stacktop);
  488.       CDR(last) = x;
  489.       last = x;
  490.     }
  491.  
  492.     ++name;
  493.   }
  494.   UNSTACK_TMP(list);
  495.   return(list);
  496. }
  497. EUFUN_CLOSE
  498.  
  499. EUFUN_2( Fn_make_string, n, rest)
  500. {
  501.   LispObject ch,str;
  502.   int i;
  503.   char cch;
  504.  
  505.   if (consp(rest)) {
  506.     ch = CAR(rest);
  507.  
  508.     if (!is_char(ch))
  509.       CallError(stacktop,"make-string: bad character",ch,NONCONTINUABLE);
  510.  
  511.     cch = (char) (ch->CHAR.code);
  512.   }
  513.   else cch = ' ';
  514.  
  515.   if (!is_fixnum(n))
  516.     CallError(stacktop,"make-string: bad length",n,NONCONTINUABLE);
  517.  
  518.   if (intval(n) < 1)
  519.     CallError(stacktop,"make-string: bad length",n,NONCONTINUABLE);
  520.  
  521.   str = (LispObject) allocate_string(stackbase, "",intval(n));
  522.  
  523.   for (i=0; i<intval(n); ++i) 
  524.     stringof(str)[i] = cch;
  525.  
  526.   stringof(str)[i] = '\0';
  527.  
  528.   return(str);
  529. }
  530. EUFUN_CLOSE
  531.  
  532. static SYSTEM_GLOBAL(int,gensym_counter);
  533.  
  534. EUFUN_0( Fn_gensym)
  535. {
  536.   char buffer[100];
  537.  
  538.   sprintf(buffer,"G%05d\0",SYSTEM_GLOBAL_VALUE(gensym_counter));
  539.   ++SYSTEM_GLOBAL_VALUE(gensym_counter);
  540.  
  541.   return((LispObject) get_symbol_by_copying(stackbase, buffer));
  542. }
  543. EUFUN_CLOSE
  544.  
  545. /* *************************************************************** */
  546. /* This is not part of the real Eulisp definition                  */  
  547. /* *************************************************************** */
  548.  
  549. EUFUN_1( Fn_mapoblist, fn)
  550. {    /* And would not work in any case --- pab */
  551.   LispObject ob = (LispObject) (ObList);
  552.  
  553.  
  554.   while (ob!=NULL) {
  555.     EUCALL_2(apply1, fn, ob);
  556.     ob = ARG_1(stacktop);
  557.     ob = (LispObject) (ob->SYMBOL).left;
  558.   }
  559.   return nil;
  560. }
  561. EUFUN_CLOSE
  562.  
  563. /* *************************************************************** */
  564. /* Initialisation of this section                                  */
  565. /* *************************************************************** */
  566.  
  567. #define STRINGS_ENTRIES 14
  568. MODULE Module_strings;
  569. LispObject Module_strings_values[STRINGS_ENTRIES];
  570.  
  571. #define CHARACTERS_ENTRIES 17
  572. MODULE Module_characters;
  573. LispObject Module_characters_values[CHARACTERS_ENTRIES];
  574.  
  575. #define SYMBOLS_ENTRIES 10
  576. MODULE Module_symbols;
  577. LispObject Module_symbols_values[SYMBOLS_ENTRIES];
  578.  
  579. void initialise_chars(LispObject *stacktop)
  580. {
  581.   LispObject fun,upd;
  582.  
  583.   open_module(stacktop,
  584.           &Module_characters,
  585.           Module_characters_values,
  586.           "characters",
  587.           CHARACTERS_ENTRIES);
  588.  
  589.   (void) make_module_function(stacktop,"characterp",Fn_characterp,1);
  590.   (void) make_module_function(stacktop,"integer-to-character",Fn_int2char,1);
  591.   (void) make_module_function(stacktop,"character-to-integer",Fn_char2int,1);
  592.   (void) make_module_function(stacktop,"char-alphabetic-p",Fn_charalphap,1);
  593.   (void) make_module_function(stacktop,"char-numeric-p",Fn_charnump,1);
  594.   (void) make_module_function(stacktop,"char-whitespace-p",Fn_charwhitep,1);
  595.   (void) make_module_function(stacktop,"char-punctuation-p",Fn_charpuncp,1);
  596.   (void) make_module_function(stacktop,"char-other-p",Fn_charotherp,1);
  597.   (void) make_module_function(stacktop,"char-upper-case-p",Fn_charupperp,1);
  598.   (void) make_module_function(stacktop,"char-lower-case-p",Fn_charlowerp,1);
  599.   (void) make_module_function(stacktop,"char-upcase",Fn_charupper,1);
  600.   (void) make_module_function(stacktop,"char-downcase",Fn_charlower,1);
  601.   (void) make_module_function(stacktop,"char-equal",Fn_chareq,2);
  602.   (void) make_module_function(stacktop,"char<",Fn_charls,2);
  603.   (void) make_module_function(stacktop,"char>",Fn_chargt,2);
  604.   (void) make_module_function(stacktop,"char<=",Fn_charle,2);
  605.   (void) make_module_function(stacktop,"char>=",Fn_charge,2);
  606.  
  607.   close_module();
  608.  
  609.   open_module(stacktop,
  610.           &Module_strings,
  611.           Module_strings_values,
  612.           "strings",
  613.           STRINGS_ENTRIES);
  614.  
  615.   (void) make_module_function(stacktop,"make-string",Fn_make_string,-2);
  616.   (void) make_module_function(stacktop,"stringp",Fn_stringp,1);
  617.   (void) make_module_function(stacktop,"string-length",Fn_string_length,1);
  618.   fun = make_module_function(stacktop,"string-ref",Fn_sref,2);
  619.   STACK_TMP(fun);
  620.   upd = make_module_function(stacktop,"string-ref-updator",Fn_sref_setter,3);
  621.   UNSTACK_TMP(fun);
  622.   set_anon_associate(stacktop,fun,upd);
  623.   (void) make_module_function(stacktop,"string-copy",Fn_string_copy,1);
  624.   (void) make_module_function(stacktop,"string-to-list",Fn_string_list,1);
  625.   (void) make_module_function(stacktop,"string-equal",Fn_string_equal,2);
  626.   (void) make_module_function(stacktop,"string-lt",Fn_string_lt,2);
  627.   (void) make_module_function(stacktop,"string-gt",Fn_string_gt,2);
  628.   (void) make_module_function(stacktop,"substring",Fn_substring,3);
  629.   (void) make_module_function(stacktop,"string-append",Fn_string_append,2);
  630.   (void) make_module_function(stacktop,"string-<=",Fn_string_le,2);
  631.   (void) make_module_function(stacktop,"string->=",Fn_string_ge,2);
  632.  
  633.   close_module();
  634.  
  635.   open_module(stacktop,
  636.           &Module_symbols,
  637.           Module_symbols_values,
  638.           "symbols",
  639.           SYMBOLS_ENTRIES);
  640.  
  641.   (void) make_module_function(stacktop,"symbolp",Fn_symbolp,1);
  642.   (void) make_module_function(stacktop,"make-symbol",Fn_make_symbol,1);
  643.   (void) make_module_function(stacktop,"symbol-name",Fn_symbolname,1);
  644.   fun = make_module_function(stacktop,"symbol-value",Fn_symbolvalue,1);
  645.   STACK_TMP(fun);
  646.   upd = make_module_function(stacktop,"symbol-value-updator",Fn_symbolvalue_update,2);
  647.   UNSTACK_TMP(fun);
  648.   set_anon_associate(stacktop,fun,upd);
  649.   fun = make_module_function(stacktop,"symbol-global",Fn_symbolglobal,1);
  650.   STACK_TMP(fun);
  651.   upd = make_module_function(stacktop,"symbol-global-updator",Fn_symbolglobal_update,2);
  652.   UNSTACK_TMP(fun);
  653.   set_anon_associate(stacktop,fun,upd);
  654.   (void) make_module_function(stacktop,"mapoblist",Fn_mapoblist,1);
  655.   
  656.   (void) make_module_function(stacktop,"explode",Fn_explode,1);
  657.  
  658.   SYSTEM_INITIALISE_GLOBAL(int,gensym_counter,0);
  659.   (void) make_module_function(stacktop,"gensym",Fn_gensym,0);
  660.  
  661.   close_module();
  662. }
  663.  
  664.